COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00010 ENDMK
C⊗;


(* (SPECIAL SIZE CLASSMAX TYPEMAX D)
   (FIXNUM (PLACE FIXNUM FIXNUM) SIZE CLASSMAX TYPEMAX D))


(PROGN (SETQ TRUE T) (SETQ FALSE NIL))


(* (PROGN (SETQ TRUE T) (SETQ FALSE NIL)))


(SETQ SIZE 511)


(SETQ CLASSMAX 3)


(SETQ TYPEMAX 12)


(SETQ D 8)


(* (SPECIAL III KOUNT) (FIXNUM III I J K KOUNT M N))


(* (ARRAY* (FIXNUM PIECECOUNT 1 CLASS 1 PIECEMAX 1)
	   (NOTYPE PUZZLE 1 P 2)))


(DEFINE-ARRAY PIECECOUNT FIXNUM (ADD1 CLASSMAX))


(DEFINE-ARRAY CLASS FIXNUM (ADD1 TYPEMAX))


(DEFINE-ARRAY PIECEMAX FIXNUM (ADD1 TYPEMAX))


(DEFINE-ARRAY PUZZLE T (ADD1 SIZE))


(DEFINE-ARRAY P T (ADD1 TYPEMAX) (ADD1 SIZE))


(DEFINEQ
 (FIT
  (LAMBDA (I J) 
    ((LAMBDA (END) 
       (FOR
	K
	FROM
	0
	TO
	END
	DO
	(COND ((*ELT P (ADD1 I) (ADD1 K))
	       (COND ((ELT PUZZLE (ADD1 (IPLUS J K))) (RETURN NIL)))))
	FINALLY
	(RETURN T)))
     (ELT PIECEMAX (ADD1 I))))))


(DEFINEQ
 (PLACE
  (LAMBDA (I J) 
    ((LAMBDA (END) 
       (FOR K
	    FROM
	    0
	    TO
	    END
	    DO
	    (COND ((*ELT P (ADD1 I) (ADD1 K))
		   (SETA PUZZLE (ADD1 (IPLUS J K)) T)))
	    FINALLY
	    (RETURN NIL))
       (SETA
	PIECECOUNT
	(ADD1 (ELT CLASS (ADD1 I)))
	(IDIFFERENCE (ELT PIECECOUNT (ADD1 (ELT CLASS (ADD1 I)))) 1))
       (FOR K
	    FROM
	    J
	    TO
	    SIZE
	    DO
	    (COND ((NOT (ELT PUZZLE (ADD1 K))) (RETURN K)))
	    FINALLY
	    (RETURN 0)))
     (ELT PIECEMAX (ADD1 I))))))


(DEFINEQ
 (REMOVE
  (LAMBDA (I J) 
    ((LAMBDA (END) 
       (FOR K
	    FROM
	    0
	    TO
	    END
	    DO
	    (COND ((*ELT P (ADD1 I) (ADD1 K))
		   (SETA PUZZLE (ADD1 (IPLUS J K)) NIL)))
	    FINALLY
	    (RETURN NIL))
       (SETA PIECECOUNT
	     (ADD1 (ELT CLASS (ADD1 I)))
	     (IPLUS (ELT PIECECOUNT (ADD1 (ELT CLASS (ADD1 I)))) 1)))
     (ELT PIECEMAX (ADD1 I))))))


(DEFINEQ
 (TRIAL
  (LAMBDA (J) 
    ((LAMBDA (K) 
       (FOR
	I
	FROM
	0
	TO
	TYPEMAX
	DO
	(COND
	 ((NOT (IEQP (ELT PIECECOUNT (ADD1 (ELT CLASS (ADD1 I)))) 0))
	  (COND ((FIT I J) (SETQ K (PLACE I J))
			   (COND ((OR (TRIAL K) (IEQP K 0))
				  (SETQ KOUNT (IPLUS KOUNT 1))
				  (RETURN T))
				 (T (REMOVE I J)))))))
	FINALLY
	(RETURN (PROGN (SETQ KOUNT (ADD1 KOUNT)) NIL))))
     0))))


(DEFINEQ
 (DEFINEPIECE
  (LAMBDA (ICLASS II JJ KK) 
    ((LAMBDA (INDEX) 
       (FOR I FROM 0 TO	II DO
	(FOR J FROM 0 TO JJ DO
	 (FOR K FROM 0 TO KK DO
	  (PROGN
	   (SETQ INDEX (IPLUS I (ITIMES D (IPLUS J (ITIMES D K)))))
	   (*SETA P (ADD1 III) (ADD1 INDEX) T))
	  FINALLY
	  (RETURN NIL))
	 FINALLY
	 (RETURN NIL))
	FINALLY
	(RETURN NIL))
       (SETA CLASS (ADD1 III) ICLASS)
       (SETA PIECEMAX (ADD1 III) INDEX)
       (COND ((NOT (IEQP III TYPEMAX)) (SETQ III (IPLUS III 1)))))
     0))))


(DEFINEQ
 (START
  (LAMBDA NIL 
    (FOR M FROM 0 TO SIZE DO
	 (SETA PUZZLE (ADD1 M) T)
	 FINALLY (RETURN NIL))
    (FOR I FROM 1 TO 5 DO
	 (FOR J FROM 1 TO 5 DO
	      (FOR K FROM 1 TO 5 DO
		   (SETA PUZZLE
			 (ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K)))))
			 NIL)
		   FINALLY (RETURN NIL))
      FINALLY (RETURN NIL))
     FINALLY (RETURN NIL))
    (FOR I
	 FROM
	 0
	 TO
	 TYPEMAX
	 DO
	 (FOR M
	      FROM
	      0
	      TO
	      SIZE
	      DO
	      (*SETA P (ADD1 I) (ADD1 M) NIL)
	      FINALLY
	      (RETURN NIL))
	 FINALLY
	 (RETURN NIL))
    (SETQ III 0)
    (DEFINEPIECE 0 3 1 0)
    (DEFINEPIECE 0 1 0 3)
    (DEFINEPIECE 0 0 3 1)
    (DEFINEPIECE 0 1 3 0)
    (DEFINEPIECE 0 3 0 1)
    (DEFINEPIECE 0 0 1 3)
    (DEFINEPIECE 1 2 0 0)
    (DEFINEPIECE 1 0 2 0)
    (DEFINEPIECE 1 0 0 2)
    (DEFINEPIECE 2 1 1 0)
    (DEFINEPIECE 2 1 0 1)
    (DEFINEPIECE 2 0 1 1)
    (DEFINEPIECE 3 1 1 1)
    (SETA PIECECOUNT 1 13)
    (SETA PIECECOUNT 2 3)
    (SETA PIECECOUNT 3 1)
    (SETA PIECECOUNT 4 1)
    ((LAMBDA (M N KOUNT) 
       (COND ((FIT 0 M) (SETQ N (PLACE 0 M)))
	     (T (TERPRI) (PRIN1 "Error")))
       (COND ((TRIAL N) (TERPRI)
			(PRIN1 "success in ")
			(PRIN1 KOUNT)
			(PRIN1 " trials"))
	     (T (TERPRI) (PRIN1 "failure")))
       (TERPRI))
     (IPLUS 1 (ITIMES D (IPLUS 1 D)))
     0
     0))))


(INCLUDE "timer.lsp")


(TIMER TIMIT (START))


(RPAQQ PUZZLECOMS ((FNS * PUZZLECOMS)))


(RPAQQ PUZZLEFNS (START DEFINEPIECE
			TRIAL
			REMOVE
			PLACE
			FIT
			START
			DEFINEPIECE
			TRIAL
			REMOVE
			PLACE
			FIT))

STOP